home *** CD-ROM | disk | FTP | other *** search
/ Suzy B Software 2 / Suzy B Software CD-ROM 2 (1994).iso / picmanip / pic_r2z / topmap / topmap.pas < prev    next >
Pascal/Delphi Source File  |  1995-05-05  |  59KB  |  1,969 lines
  1. {*****************************************************************************}
  2. {*****************************************************************************}
  3. {                                                                             }
  4. {                     Fractal Topographical Maps v0.2                         }
  5. {                   Copyright (c) 1987 by Robert Adam II.                     }
  6. {                         All rights reserved.                                }
  7. {                                                                             }
  8. {*****************************************************************************}
  9. {*****************************************************************************}
  10. {                                                                             }
  11. {      WARNING:  This code is mostly uncommented and may be hazardous to      }
  12. {               your mental health.                                           }
  13. {                Don't blame me,  I warned you.                               }
  14. {                                                                             }
  15. {*****************************************************************************}
  16. {*****************************************************************************}
  17.  
  18. program TOPMAP;
  19.  
  20.   const
  21.     COPYRIGHT1 = ' Fractal Topographical Maps v0.2 ';
  22.     COPYRIGHT2 = ' Copyright (c) 1987 by Robert Adam II. ';
  23.     COPYRIGHT3 = ' All rights reserved. ';
  24.  
  25.     {$I A:\GEMCONST}
  26.     {$I A:\VDICONST}
  27.  
  28.     PI = 3.1415936535;
  29.  
  30.     WSX = 10;
  31.     WSY = 10;
  32.  
  33.     SCALEX = 290;
  34.     SCALEY = WSY;
  35.     SCALEW = 15;
  36.     SCALEH = 130;
  37.  
  38.     MAXXTILES = 3;
  39.     MAXYTILES = 2;
  40.  
  41.     MAXALTITUDE = 25000;
  42.     RMAXALTITUDE = 25000.0;
  43.  
  44.     NUMLEVELS  = 7;
  45.     FIRSTLEVEL = 1;
  46.  
  47.     PIXEL_SIZE = 1;
  48.     MAP_SIZE = 65;
  49.     PMAP_SIZE = 65;          { = MAP_SIZE * PIXEL_SIZE }
  50.     PMAP_SIZE2 = 28;
  51.  
  52.     DESK_TITLE = 3;
  53.  
  54.     NUM_PLANES = 4;
  55.  
  56. {*****************************************************************************}
  57.  
  58.   type
  59.     {$I A:\GEMTYPE}
  60.     {$I A:\VDITYPE}
  61.  
  62.     SHADOWREGION = record
  63.                      OHEIGHT,
  64.                      OX, OY,
  65.                      SLENGTH : integer
  66.                    end;
  67.  
  68.     POINT3      = record
  69.                     X, Y, Z : real
  70.                   end;
  71.     TRANSFORM = record
  72.                   U, V, W : POINT3;
  73.                   UE, VE, WE : real
  74.                 end;
  75.  
  76.  
  77.     COLOR_VECTOR = array[ 0..15 ] of integer;
  78.  
  79.     MEMAREA     = array[ 1..16000 ] of integer;
  80.     MEMPTR      = ^MEMAREA;
  81.  
  82.     LONGITUDE   = array[ 1..MAP_SIZE ] of integer;
  83.     TILE_TYPE   = array[ 1..MAP_SIZE ] of LONGITUDE;
  84.     TILETYPE    = ^TILE_TYPE;
  85.     MAPTYPE     = array[ 1..MAXXTILES, 1..MAXYTILES ] of TILETYPE;
  86.  
  87.     POINT       = record
  88.                     X, Y : integer
  89.                   end;
  90.  
  91. {*****************************************************************************}
  92.  
  93.  
  94.   var
  95.     {$I A:\VDIVARS}
  96.  
  97.     SIDE,
  98.     MAXX,
  99.     MAXY  : integer;
  100.  
  101.     SUNANGLE,
  102.     TANGENT : real;
  103.  
  104.     DEF_PATH,
  105.     FILENAME : path_name;
  106.  
  107.     BRAND_NEW,
  108.     WATCH_ON,
  109.     SHADOW_ON : boolean;
  110.  
  111.     WX, WY : integer;
  112.  
  113.     MAP   : MAPTYPE;
  114.  
  115.     DUMMY : integer;
  116.  
  117.     QUANTUM : integer;
  118.  
  119.     XSCRN,
  120.     YSCRN,
  121.     WSCRN,
  122.     HSCRN : integer;
  123.  
  124.   { Window variables }
  125.     INFO_LINE,
  126.     MAIN_TITLE : window_title;
  127.     GRAPHICS_WINDOW : integer;
  128.  
  129.  
  130.   { Menu variables }
  131.     MENU : menu_ptr ;
  132.  
  133.     FILE_TITLE,
  134.     OPTIONS_TITLE,
  135.     VIEW_TITLE,
  136.     WIDTH_ITEM,
  137.     HEIGHT_ITEM,
  138.     RESET_ITEM,
  139.     WATCH_ITEM,
  140.     WATER_ITEM,
  141.     SHADOW_ITEM,
  142.     NULL_ITEM,
  143.     NULL2_ITEM,
  144.     OLD_ITEM,
  145.     NEW_ITEM,
  146.     LOAD_ITEM,
  147.     SAVE_ITEM,
  148.     PERSPEC_ITEM,
  149.     SIDE_ITEM,
  150.     TOP_ITEM,
  151.     QUIT_ITEM : integer ;
  152.  
  153.     OSS_DIALOG,
  154.     ABOUT_DIALOG : dialog_ptr;
  155.  
  156.  
  157.   { mfdb variables }
  158.     PXY    : PXYARRAY;
  159.     MEMORY : MEMPTR;
  160.     S_MFDB,
  161.     D_MFDB : mfdbptr;
  162.  
  163.     NUMXTILES,
  164.     NUMYTILES : integer;
  165.  
  166.   { old color vector }
  167.     OLD_COLOR : COLOR_VECTOR;
  168.  
  169.     WATER_LINE,
  170.     WATER_LEVEL : integer;
  171.     WATER_ON : boolean;
  172.     LEVELS : array[ 1..NUMLEVELS ] of integer;
  173.  
  174.     SCALE_ON : boolean;
  175.  
  176.     LIGHT,
  177.     SHADOW : array[ 1..7 ] of integer;
  178.  
  179.   {$I A:\GEMSUBS}
  180.   {$I A:\VDIPROC}
  181.  
  182. {*****************************************************************************}
  183. {*****************************************************************************}
  184. {*****************************************************************************}
  185.  
  186.   function QUICK_EXIT : boolean;
  187.     begin
  188.       AES_CALL( 79, INT_IN, INT_OUT, ADDR_IN, ADDR_OUT );
  189.       if (INT_OUT[ 3 ] & 3) <> 0
  190.       then
  191.         QUICK_EXIT := 1 = do_alert('[2][| Cancel?     |][Yes|No]',2)
  192.       else
  193.         QUICK_EXIT := false;
  194.     end;
  195.  
  196. {*****************************************************************************}
  197.  
  198.   function setcolor( COLORNUM, COLOR : integer ) : integer;
  199.     xbios( 7 );
  200.  
  201.   function GET_XCOLOR( COLORNUM : integer ) : integer;
  202.     begin
  203.       GET_XCOLOR := setcolor( COLORNUM, -1 );
  204.     end;
  205.  
  206.  
  207.   procedure SET_XCOLOR( COLORNUM, COLOR : integer);
  208.     var
  209.       DUMMY : integer;
  210.     begin
  211.       DUMMY := setcolor( COLORNUM, COLOR );
  212.     end;
  213.  
  214.  
  215.   procedure SAVE_COLORS;
  216.     var
  217.       COLORNUM : integer;
  218.     begin
  219.       for COLORNUM := 0 to 15 do
  220.         OLD_COLOR[ COLORNUM ] := GET_XCOLOR( COLORNUM );
  221.     end;
  222.  
  223.  
  224.   procedure RESTORE_COLORS;
  225.     var
  226.       COLORNUM : integer;
  227.     begin
  228.       for COLORNUM := 0 to 15 do
  229.         SET_XCOLOR( COLORNUM, OLD_COLOR[ COLORNUM ] );
  230.     end;
  231.  
  232.  
  233.   procedure SET_GEM_COLOR( COLORNUM, RED, GREEN, BLUE : integer );
  234.     begin
  235.       set_color( COLORNUM, RED*125, GREEN*125, BLUE*125 );
  236.     end;
  237.  
  238. {*****************************************************************************}
  239.  
  240.   procedure DRAW_SCALE;
  241.     var
  242.       I,
  243.       Y,
  244.       HEIGHT : integer;
  245.     begin
  246.       paint_color( 1 );
  247.       paint_rect( SCALEX-2, SCALEY-2, SCALEW+4, SCALEH+8 );
  248.       Y := SCALEY;
  249.       for I := NUMLEVELS downto 1 do
  250.         begin
  251.           HEIGHT := trunc( LEVELS[ I ] * 1.0 * SCALEH / MAXALTITUDE );
  252.           paint_color( LIGHT[ I ] );
  253.           paint_rect( SCALEX, Y, (SCALEW div 2), HEIGHT );
  254.           paint_color( SHADOW[ I ] );
  255.           paint_rect( SCALEX+(SCALEW div 2), Y, (SCALEW div 2), HEIGHT );
  256.           Y := Y + HEIGHT + 1;
  257.         end;
  258.     end;
  259.  
  260.  
  261.   procedure SPECIAL_COLORS;
  262.     begin
  263.       SET_GEM_COLOR(  0, 7, 7, 7 );
  264.       SET_GEM_COLOR(  1, 0, 0, 0 );
  265.       SET_GEM_COLOR(  2, 5, 0, 0 );
  266.       SET_GEM_COLOR(  3, 0, 2, 0 );
  267.  
  268.       SET_GEM_COLOR(  5, 4, 7, 7 );   { COLOR OF SIDES IN PERSPEC }
  269.  
  270.       SET_GEM_COLOR(  8, 0, 0, 5 );   SHADOW[ 1 ] :=  8;
  271.                                       SHADOW[ 2 ] := 11;
  272.                                       SHADOW[ 3 ] := 12;
  273.       SET_GEM_COLOR(  7, 1, 2, 0 );   SHADOW[ 4 ] :=  7;
  274.       SET_GEM_COLOR(  6, 3, 2, 0 );   SHADOW[ 5 ] :=  6; { INSIDE OF EARTH }
  275.                                       SHADOW[ 6 ] := 13;
  276.       SET_GEM_COLOR(  4, 5, 5, 5 );   SHADOW[ 7 ] :=  4;
  277.  
  278.       SET_GEM_COLOR(  9, 0, 0, 7 );   LIGHT[ 1 ]  :=  9;
  279.       SET_GEM_COLOR( 10, 0, 6, 0 );   LIGHT[ 2 ]  := 10;
  280.       SET_GEM_COLOR( 11, 0, 4, 0 );   LIGHT[ 3 ]  := 11;
  281.       SET_GEM_COLOR( 12, 2, 3, 0 );   LIGHT[ 4 ]  := 12;
  282.       SET_GEM_COLOR( 13, 5, 3, 1 );   LIGHT[ 5 ]  := 13;
  283.       SET_GEM_COLOR( 14, 6, 4, 1 );   LIGHT[ 6 ]  := 14;
  284.       SET_GEM_COLOR( 15, 6, 6, 6 );   LIGHT[ 7 ]  := 15;
  285.     end;
  286.  
  287.  
  288.   procedure SET_SPECIAL_COLORS;
  289.     var
  290.       I : integer;
  291.     begin
  292.       SPECIAL_COLORS;
  293.       WATER_LEVEL := 1;
  294.       QUANTUM := MAXALTITUDE div (NUMLEVELS + 2);
  295.       for I := 2 to NUMLEVELS do LEVELS[ I ] := QUANTUM;
  296.       LEVELS[ 1 ] := 3*QUANTUM;
  297.       WATER_LINE := QUANTUM*3;
  298.     end;
  299.  
  300. {*****************************************************************************}
  301.  
  302.   function min( INT1, INT2 : integer ) : integer;
  303.     begin
  304.       if INT1 > INT2
  305.       then
  306.         min := INT2
  307.       else
  308.         min := INT1;
  309.     end;
  310.  
  311.  
  312.   function max( INT1, INT2 : integer ) : integer;
  313.     begin
  314.       if INT1 >= INT2
  315.       then
  316.         max := INT1
  317.       else
  318.         max := INT2;
  319.     end;
  320.  
  321.  
  322. {*****************************************************************************}
  323. {  The following routines are used to save the graphics window and then       }
  324. { restore portions of it during window redraw.                                }
  325. {*****************************************************************************}
  326.  
  327.   function MEMPTR_TO_LINT( PNTR : MEMPTR ) : long_integer;
  328.     var
  329.       COERCE : record
  330.                  case boolean of
  331.                    false : ( PTR : MEMPTR );
  332.                    true  : ( ADR : long_integer );
  333.                end;
  334.     begin
  335.       COERCE.PTR := PNTR;
  336.       MEMPTR_TO_LINT := COERCE.ADR;
  337.     end;
  338.  
  339.  
  340.   procedure READY_MFDB;
  341.     begin
  342.       S_MFDB^.MP  := MEMPTR_TO_LINT( MEMORY );
  343.       S_MFDB^.FWP := WSCRN;
  344.       S_MFDB^.FH  := HSCRN;
  345.       S_MFDB^.FWW := (WSCRN div 16);
  346.       S_MFDB^.FF  := 0;
  347.       S_MFDB^.NP  := NUM_PLANES;
  348.       S_MFDB^.R1  := 0;
  349.       S_MFDB^.R2  := 0;
  350.       S_MFDB^.R3  := 0;
  351.  
  352.       D_MFDB^.MP  := 0;
  353.     end;
  354.  
  355.  
  356.   procedure SAVE_AREA( X, Y, W, H : integer );
  357.     begin
  358.       begin_update; hide_mouse;
  359.  
  360.       PXY[ 0 ] := X;            PXY[ 1 ] := Y;
  361.       PXY[ 2 ] := X+W-1;        PXY[ 3 ] := Y+H-1;
  362.       PXY[ 4 ] := X;            PXY[ 5 ] := Y;
  363.       PXY[ 6 ] := X+W-1;        PXY[ 7 ] := Y+H-1;
  364.  
  365.       vro_cpyform( 3, PXY, D_MFDB, S_MFDB );
  366.  
  367.       show_mouse;   end_update;
  368.     end;
  369.  
  370.  
  371.   procedure RESTORE_AREA( X, Y, W, H : integer );
  372.     begin
  373.       begin_update; hide_mouse;
  374.  
  375.       PXY[ 0 ] := X;            PXY[ 1 ] := Y;
  376.       PXY[ 2 ] := X+W-1;        PXY[ 3 ] := Y+H-1;
  377.       PXY[ 4 ] := X;            PXY[ 5 ] := Y;
  378.       PXY[ 6 ] := X+W-1;        PXY[ 7 ] := Y+H-1;
  379.  
  380.       vro_cpyform( 3, PXY, S_MFDB, D_MFDB );
  381.  
  382.       show_mouse;   end_update;
  383.     end;
  384.  
  385.  
  386.   procedure COPY_AREA( XF, YF, WF, HF, XT, YT, WT, HT : integer );
  387.     begin
  388.       PXY[ 0 ] := XF;           PXY[ 1 ] := YF;
  389.       PXY[ 2 ] := WF;           PXY[ 3 ] := HF;
  390.       PXY[ 4 ] := XT;           PXY[ 5 ] := YT;
  391.       PXY[ 6 ] := WT;           PXY[ 7 ] := HT;
  392.       D_MFDB^.MP := 0;
  393.       vro_cpyform( 3, PXY, D_MFDB, D_MFDB );
  394.     end;
  395.  
  396. {*****************************************************************************}
  397.  
  398.   function RANDOM24 : long_integer;
  399.     XBIOS( 17 );
  400.  
  401.  
  402.   function RANDOM( MINR, MAXR : integer ) : integer;
  403.     begin
  404.       RANDOM := trunc( RANDOM24 * (MAXR - MINR + 1.0) / $00FFFFFF ) + MINR;
  405.     end;
  406.  
  407. {*****************************************************************************}
  408.  
  409.   procedure CLEAR_MAP_AREA;
  410.     begin
  411.       set_window( GRAPHICS_WINDOW );
  412.       paint_color( 1 );
  413.       paint_rect( WSX-2, WSY-2,
  414.                   (NUMXTILES*PMAP_SIZE)+4-(NUMXTILES-1),
  415.                   (NUMYTILES*PMAP_SIZE)+4-(NUMYTILES-1)
  416.                 );
  417.       paint_color( 0 );
  418.       paint_rect( WSX, WSY,
  419.                   (NUMXTILES*PMAP_SIZE)-(NUMXTILES-1),
  420.                   (NUMYTILES*PMAP_SIZE)-(NUMYTILES-1)
  421.                 );
  422.  
  423.     end;
  424.  
  425.  
  426.   procedure FLATTEN_MAP( var MAP : MAPTYPE );
  427.   {                                                                           }
  428.   { Fill the map with an illegal value (-1) so that you can later distinguish }
  429.   { between a used and unused location.                                       }
  430.   {                                                                           }
  431.     var
  432.       TILEX, TILEY,
  433.       X, Y : integer;
  434.     begin
  435.       for TILEX := 1 to NUMXTILES do
  436.         for TILEY := 1 to NUMYTILES do
  437.           for X := 1 to MAP_SIZE do
  438.             for Y := 1 to MAP_SIZE do
  439.               MAP[ TILEX, TILEY ]^[ X, Y ] := -1;
  440.     end;
  441.  
  442.  
  443.   function ALT_TO_COL( ALT : integer ): integer;
  444.   {                                                                           }
  445.   { this function maps an altitude to a color                                 }
  446.   {                                                                           }
  447.     var
  448.       I,
  449.       COL : integer;
  450.     begin
  451.       I := 1;
  452.       loop
  453.         ALT := ALT - LEVELS[ I ]
  454.       exit if (ALT <= 0) or (I >= NUMLEVELS);
  455.         I := I + 1
  456.       end;
  457.       COL := (I-1) + FIRSTLEVEL;
  458.  
  459.       if WATER_ON
  460.       then
  461.         ALT_TO_COL := max( WATER_LEVEL, COL )
  462.       else
  463.         ALT_TO_COL := COL;
  464.     end;
  465.  
  466.  
  467.   procedure PLOT_LOCATION( var MAP : TILETYPE;
  468.                            LOCATION : POINT
  469.                          );
  470.   {                                                                    }
  471.   { Plots a pixel during the creation of the map if WATCH is turned on }
  472.   {                                                                    }
  473.     begin
  474.       if WATCH_ON
  475.       then
  476.         with LOCATION do
  477.           begin
  478.             paint_color( LIGHT[ALT_TO_COL( MAP^[ X, Y ] )] );
  479.             paint_rect( WX+PIXEL_SIZE*(X-1), WY+PIXEL_SIZE*(Y-1),
  480.                         PIXEL_SIZE, PIXEL_SIZE
  481.                       );
  482.           end;
  483.     end;
  484.  
  485.  
  486.   function USED_LOCATION( var MAP : TILETYPE;
  487.                           LOCATION : POINT
  488.                         ) : boolean;
  489.   {                                                                           }
  490.   { returns true if the location has been assigned an altitude                }
  491.   { returns false otherwise                                                   }
  492.   {                                                                           }
  493.     begin
  494.       USED_LOCATION := MAP^[ LOCATION.X, LOCATION.Y ] >= 0;
  495.     end;
  496.  
  497.  
  498.   procedure RANDOM_POINT( var MAP : TILETYPE;   { one tile of the map         }
  499.                               LOCATION : POINT; { location to assign altitude }
  500.                               LOWER,            { lower bound of region       }
  501.                               UPPER : integer   { upper bound of region       }
  502.                         );
  503.   { assign a random altitude within the specified range to the location on }
  504.   { the map specified if the location has not yet been used                }
  505.     begin
  506.       if not USED_LOCATION( MAP, LOCATION )
  507.       then
  508.         with LOCATION do
  509.           MAP^[ X, Y ] := RANDOM( LOWER, UPPER );
  510.     end;
  511.  
  512.  
  513.   procedure DEFINE_START( var MAP : MAPTYPE;
  514.                               TILEX, TILEY : integer;
  515.                           var TL, TR, BR, BL : POINT
  516.                         );
  517.   {                                                                           }
  518.   { assigns values to the seed points of a tile (the corners)                 }
  519.   {                                                                           }
  520.     var
  521.       I,
  522.       LOW_BOUND, HI_BOUND : integer;
  523.     begin
  524.       if (TILEY-1) >= 1
  525.       then
  526.         for I := 1 to MAP_SIZE do
  527.           MAP[ TILEX, TILEY ]^[ I, 1 ]
  528.                := MAP[ TILEX, TILEY-1 ]^[ I, MAP_SIZE ];
  529.  
  530.       if (TILEX-1) >= 1
  531.       then
  532.         for I := 1 to MAP_SIZE do
  533.           MAP[ TILEX, TILEY ]^[ 1, I ]
  534.                := MAP[ TILEX-1, TILEY ]^[ MAP_SIZE, I ];
  535.  
  536.  
  537.       TL.X := 1;        TL.Y := 1;
  538.       TR.X := MAP_SIZE; TR.Y := 1;
  539.       BR.X := MAP_SIZE; BR.Y := MAP_SIZE;
  540.       BL.X := 1;        BL.Y := MAP_SIZE;
  541.       LOW_BOUND := trunc( QUANTUM * 2.00 );
  542.       HI_BOUND  := MAXALTITUDE - LOW_BOUND;
  543.       RANDOM_POINT( MAP[ TILEX, TILEY ], TL, LOW_BOUND, HI_BOUND );
  544.       RANDOM_POINT( MAP[ TILEX, TILEY ], TR, LOW_BOUND, HI_BOUND );
  545.       RANDOM_POINT( MAP[ TILEX, TILEY ], BR, LOW_BOUND, HI_BOUND );
  546.       RANDOM_POINT( MAP[ TILEX, TILEY ], BL, LOW_BOUND, HI_BOUND );
  547.     end;
  548.  
  549.  
  550.   procedure NEW_HORIZONTAL( var MAP : TILETYPE; { one tile of the map }
  551.                                 LEFT,           { Left point of top or bottom }
  552.                                 RIGHT : POINT;  { Right point of top or bottom}
  553.                             var MID : POINT     { Middle point of line }
  554.                           );
  555.     var
  556.       DIFF,
  557.       LEFT_ALT, RIGHT_ALT, MID_ALT
  558.        : integer;
  559.     begin
  560.       MID.Y := LEFT.Y;
  561.       MID.X := LEFT.X + ((RIGHT.X - LEFT.X) div 2);
  562.  
  563.       if not USED_LOCATION( MAP, MID )
  564.       then
  565.         begin
  566.           LEFT_ALT  := MAP^[ LEFT.X, LEFT.Y ];
  567.           RIGHT_ALT := MAP^[ RIGHT.X, RIGHT.Y ];
  568.           DIFF := abs( LEFT_ALT - RIGHT_ALT );
  569.           MID_ALT := min( LEFT_ALT, RIGHT_ALT ) + (DIFF div 2);
  570.           DIFF := trunc( (RIGHT.X - LEFT.X) * RMAXALTITUDE / MAP_SIZE);
  571.           DIFF := (DIFF div 2) - RANDOM( 0, DIFF );
  572.           if (DIFF > 0) and
  573.              ((MAXALTITUDE-MID_ALT) < DIFF)
  574.           then
  575.             DIFF := MAXALTITUDE - MID_ALT;
  576.  
  577.           MAP^[ MID.X, MID.Y ] := max( 0, (MID_ALT + DIFF) );
  578.         end;
  579.     end;
  580.  
  581.  
  582.   procedure NEW_VERTICAL( var MAP : TILETYPE;  { one tile of the map      }
  583.                               TOP,             { Top point of a side      }
  584.                               BOT : POINT;     { Bottom point of a side   }
  585.                           var MID : POINT      { Middle point of the side }
  586.                         );
  587.     var
  588.       DIFF,
  589.       TOP_ALT, BOT_ALT, MID_ALT : integer;
  590.     begin
  591.       MID.X := TOP.X;
  592.       MID.Y := TOP.Y + ((BOT.Y - TOP.Y) div 2);
  593.  
  594.       if not USED_LOCATION( MAP, MID )
  595.       then
  596.         begin
  597.           TOP_ALT := MAP^[ TOP.X, TOP.Y ];
  598.           BOT_ALT := MAP^[ BOT.X, BOT.Y ];
  599.           DIFF := abs( TOP_ALT - BOT_ALT );
  600.           MID_ALT := min( TOP_ALT, BOT_ALT ) + (DIFF div 2);
  601.           DIFF := trunc( (BOT.Y - TOP.Y) * RMAXALTITUDE / MAP_SIZE );
  602.           DIFF := (DIFF div 2) - RANDOM( 0, DIFF );
  603.           if (DIFF > 0) and
  604.              ((MAXALTITUDE-MID_ALT) < DIFF)
  605.           then
  606.             DIFF := MAXALTITUDE - MID_ALT;
  607.  
  608.           MAP^[ MID.X, MID.Y ] := max( 0, (MID_ALT + DIFF) );
  609.         end;
  610.     end;
  611.  
  612.  
  613.   procedure NEW_CENTER( var MAP : TILETYPE;  { one tile of the map      }
  614.                             TM,              { Top Middle point         }
  615.                             RM,              { Right Middle point       }
  616.                             BM,              { Bottom Middle point      }
  617.                             LM : POINT;      { Left Middle point        }
  618.                         var CENTER : POINT   { Center point             }
  619.                       );
  620.     var
  621.       DIFF,
  622.       TOP_ALT, BOT_ALT, RIGHT_ALT, LEFT_ALT, MAX_ALT, MIN_ALT,
  623.       AVERAGE1, AVERAGE2, AVERAGE : integer;
  624.     begin
  625.       CENTER.X := TM.X;
  626.       CENTER.Y := LM.Y;
  627.  
  628.       if not USED_LOCATION( MAP, CENTER )
  629.       then
  630.         begin
  631.           TOP_ALT := MAP^[ TM.X, TM.Y ];
  632.           BOT_ALT := MAP^[ BM.X, BM.Y ];
  633.           RIGHT_ALT := MAP^[ RM.X, RM.Y ];
  634.           LEFT_ALT := MAP^[ LM.X, LM.Y ];
  635.           AVERAGE1 := trunc( (TOP_ALT*1.0 + BOT_ALT) / 2 );
  636.           AVERAGE2 := trunc( (RIGHT_ALT*1.0 + LEFT_ALT) / 2 );
  637.           AVERAGE := trunc( (AVERAGE1*1.0 + AVERAGE2) / 2 );
  638.           DIFF := trunc( (BM.Y - TM.Y) * RMAXALTITUDE / MAP_SIZE );
  639.           DIFF := (DIFF div 2) - RANDOM( 0, DIFF );
  640.           if (DIFF > 0) and
  641.              ((MAXALTITUDE-AVERAGE) < DIFF)
  642.           then
  643.             DIFF := MAXALTITUDE - (AVERAGE+1);
  644.  
  645.           MAP^[ CENTER.X, CENTER.Y ] := max( 0, (AVERAGE + DIFF) );
  646.         end;
  647.     end;
  648.  
  649.  
  650.   procedure EVOLVE_LANDSCAPE( var MAP : TILETYPE; { one tile of the map }
  651.                                   TL,             { Top Left     corner }
  652.                                   TR,             { Top Right    corner }
  653.                                   BR,             { Bottom Right corner }
  654.                                   BL : POINT      { Bottom Left  corner }
  655.                             );
  656.     var
  657.       TM, RM, BM, LM, CENTER : POINT;
  658.       I, TMP, TWIDDLE : integer;
  659.       SPLAY : array[ 1..4 ] of 1..4;
  660.     begin
  661.       if ((TR.X - TL.X) > 1) or
  662.          ((BR.Y - TR.Y) > 1)
  663.       then
  664.         begin
  665.           NEW_HORIZONTAL( MAP, TL, TR, TM );
  666.           NEW_HORIZONTAL( MAP, BL, BR, BM );
  667.           NEW_VERTICAL( MAP, TL, BL, LM );
  668.           NEW_VERTICAL( MAP, TR, BR, RM );
  669.           NEW_CENTER( MAP, TM, RM, BM, LM, CENTER );
  670.  
  671. { randomize the splay array }
  672.           for I := 1 to 4 do SPLAY[ I ] := I;
  673.           for I := 1 to 10 do
  674.             begin
  675.               TMP := SPLAY[ 1 ];
  676.               TWIDDLE := RANDOM( 1, 4 );
  677.               SPLAY[ 1 ] := SPLAY[ TWIDDLE ];
  678.               SPLAY[ TWIDDLE ] := TMP;
  679.             end;
  680.  
  681. { evolve the four subrectangles }
  682.           for I := 1 to 4 do
  683.             case SPLAY[ I ] of
  684.               1 : EVOLVE_LANDSCAPE( MAP, TL, TM, CENTER, LM );
  685.               2 : EVOLVE_LANDSCAPE( MAP, TM, TR, RM, CENTER );
  686.               3 : EVOLVE_LANDSCAPE( MAP, LM, CENTER, BM, BL );
  687.               4 : EVOLVE_LANDSCAPE( MAP, CENTER, RM, BR, BM )
  688.             end
  689.         end;
  690.  
  691. { show the points }
  692.       PLOT_LOCATION( MAP, TL );
  693.       PLOT_LOCATION( MAP, TR );
  694.       PLOT_LOCATION( MAP, BR );
  695.       PLOT_LOCATION( MAP, BL );
  696.  
  697.     end;
  698.  
  699.  
  700.   procedure INIT_GWINDOW;
  701.     var
  702.       X, Y, H, W : integer;
  703.  
  704.     begin
  705.       hide_mouse;
  706.       bring_to_front( GRAPHICS_WINDOW );
  707.       draw_mode( 1 );
  708.       paint_color( 0 );
  709.       work_rect( GRAPHICS_WINDOW, X, Y, W, H );
  710.       set_clip( X, Y, W, H );
  711.       set_window( GRAPHICS_WINDOW );
  712.       paint_rect( 0, 0, W, H );
  713.       FLATTEN_MAP( MAP );
  714.       CLEAR_MAP_AREA;
  715.       DRAW_SCALE;
  716.       SAVE_AREA( X, Y, W, H );
  717.       show_mouse;
  718.     end;
  719.  
  720.  
  721.   procedure REDRAW_MAP( var MAP : MAPTYPE );
  722.   forward;
  723.  
  724.  
  725.   procedure DRAW_MAP( var MAP : MAPTYPE );
  726.     var
  727.       TL, TR, BR, BL : POINT;
  728.       TILEX, TILEY : integer;
  729.     begin
  730.       bring_to_front( GRAPHICS_WINDOW );
  731.       INIT_GWINDOW;
  732.       begin_update; hide_mouse;
  733.       for TILEX := 1 to NUMXTILES do
  734.         for TILEY := 1 to NUMYTILES do
  735.           begin
  736.             WX := WSX + ((TILEX-1) * (PMAP_SIZE-PIXEL_SIZE));
  737.             WY := WSY + ((TILEY-1) * (PMAP_SIZE-PIXEL_SIZE));
  738.             DEFINE_START( MAP, TILEX, TILEY, TL, TR, BR, BL );
  739.             EVOLVE_LANDSCAPE( MAP[ TILEX, TILEY ], TL, TR, BR, BL );
  740.           end;
  741.       SAVE_AREA( XSCRN, YSCRN, WSCRN, HSCRN );
  742.       show_mouse; end_update;
  743.       BRAND_NEW := true;
  744.       if SHADOW_ON
  745.       then
  746.         if do_alert('[2][| Add shadows?  |][Yes|No]',1) = 1
  747.         then
  748.           REDRAW_MAP( MAP );
  749.       BRAND_NEW := false;
  750.     end;
  751.  
  752. {*****************************************************************************}
  753.  
  754.   procedure ENLIGHTEN( var SHADOW_REGION : SHADOWREGION );
  755.   { sets the shadow to the shadow of an object of zero height }
  756.     begin
  757.       with SHADOW_REGION do
  758.         begin
  759.            OHEIGHT := 0;
  760.            OX := 1;  OY := 1;
  761.            SLENGTH := 0;
  762.         end;
  763.     end;
  764.  
  765.  
  766.   procedure PLOT_SRECT( var MAP : MAPTYPE;
  767.                             IX, IY, TX, TY, XX, YY,
  768.                             XPNT, YPNT, MAXX, MAXY : integer;
  769.                         var SHADOW_REGION : SHADOWREGION
  770.                       );
  771.   { Plot a shadowed rectangle                                                 }
  772.     var
  773.       SHADOW_LENGTH,
  774.       SHADOW_HEIGHT,
  775.       OBJECT_HEIGHT,
  776.       COLOR : integer;
  777.       HEIGHT : real;
  778.     begin
  779.       with SHADOW_REGION do
  780.         begin
  781.           HEIGHT := MAP[TX,TY]^[XX,YY];
  782.           if WATER_ON
  783.           then
  784.             if HEIGHT < WATER_LINE
  785.             then
  786.               HEIGHT := WATER_LINE;
  787.  
  788.           COLOR := ALT_TO_COL( round(HEIGHT) );
  789.           SHADOW_LENGTH := round( (HEIGHT * PMAP_SIZE2)
  790.                                   / (RMAXALTITUDE * TANGENT)
  791.                                 );
  792.           OBJECT_HEIGHT := round( HEIGHT * PMAP_SIZE2 / RMAXALTITUDE );
  793.  
  794.           if (IX + SHADOW_LENGTH) <= (OX + SLENGTH)
  795.           then
  796.             begin
  797.               if ( (IX = MAXX) or
  798.                    (IY = MAXY)
  799.                  )
  800.               then
  801.                 paint_color( 6 )
  802.               else
  803.                 paint_color( SHADOW[ COLOR ] );
  804.  
  805.               paint_rect( XPNT+IX,       YPNT-OBJECT_HEIGHT,
  806.                           PIXEL_SIZE,    OBJECT_HEIGHT
  807.                         );
  808.             end
  809.           else
  810.             begin
  811.               if SLENGTH <= 0
  812.               then
  813.                SHADOW_HEIGHT := 0
  814.               else
  815.                SHADOW_HEIGHT := round( (0.0+SLENGTH-(IX-OX))*OHEIGHT/SLENGTH );
  816.               if ( (IX = MAXX) or
  817.                    (IY = MAXY)
  818.                  )
  819.               then
  820.                 paint_color( 6 )
  821.               else
  822.                 paint_color( LIGHT[ COLOR ] );
  823.               paint_rect( XPNT+IX,    YPNT-OBJECT_HEIGHT,
  824.                           PIXEL_SIZE, OBJECT_HEIGHT
  825.                         );
  826.               if ( (IX = MAXX) or
  827.                    (IY = MAXY)
  828.                  )
  829.               then
  830.                 paint_color( 6 )
  831.               else
  832.                 paint_color( SHADOW[ COLOR ] );
  833.               paint_rect( XPNT+IX,    YPNT-SHADOW_HEIGHT,
  834.                           PIXEL_SIZE, SHADOW_HEIGHT
  835.                         );
  836.  
  837.               SLENGTH := SHADOW_LENGTH;
  838.               OHEIGHT := OBJECT_HEIGHT;
  839.               OX := IX;  OY := IY;
  840.             end;
  841.  
  842.         end;
  843.     end;
  844.  
  845.  
  846.   function DEG_TO_RAD( DEGREES : real ) : real;
  847.     begin
  848.       DEG_TO_RAD := DEGREES * PI / 180.0;
  849.     end;
  850.  
  851.  
  852.   function GET_TANGENT : real;
  853.   {                                                                          }
  854.   { this function gets the angle of the sun and returns the tangent          }
  855.   {                                                                          }
  856.     var
  857.       ANSWER : integer;
  858.     begin
  859.       ANSWER := do_alert('[0][| Sun Angle?   |][L|M|H]',2);
  860.       case ANSWER of
  861.         1 : SUNANGLE := 15.0;
  862.         2 : SUNANGLE := 45.0;
  863.         3 : SUNANGLE := 75.0
  864.       end;
  865.  
  866.       SUNANGLE := DEG_TO_RAD( SUNANGLE );
  867.       GET_TANGENT := sin( SUNANGLE ) / cos( SUNANGLE );
  868.     end;
  869.  
  870.  
  871.   procedure SIDE_MAP( var MAP : MAPTYPE );
  872.   {                                                                         }
  873.   { this procedure draw an isometric view of the map                        }
  874.   {                                                                         }
  875.     var
  876.       DONE : boolean;
  877.       HEIGHT,
  878.       COLOR,
  879.       XPNT, YPNT,
  880.       TX, TY, XX, YY,
  881.       IX, IY,
  882.       X, Y, W, H : integer;
  883.       SHADOW_REGION : SHADOWREGION;
  884.     begin
  885.       bring_to_front( GRAPHICS_WINDOW );
  886.       draw_mode( 1 );
  887.       paint_style( 1 );
  888.       paint_color( 1 );
  889.       work_rect( GRAPHICS_WINDOW, X, Y, W, H );
  890.       set_clip( X, Y, W, H );
  891.       set_window( GRAPHICS_WINDOW );
  892.       begin_update; hide_mouse;
  893.       paint_rect( 0, 0, W, H );
  894.       DRAW_SCALE;
  895.       if SHADOW_ON
  896.       then
  897.         TANGENT := GET_TANGENT;
  898.  
  899.       line_style( 1 );
  900.       XPNT := WSX + PMAP_SIZE - 1;
  901.       YPNT := WSY + PMAP_SIZE2 + 2;
  902.       IY := 0;
  903.       loop
  904.         IX := 0;
  905.         ENLIGHTEN( SHADOW_REGION );
  906.         TY := (IY div SIDE) + 1;
  907.         YY := (IY mod SIDE) + 1;
  908.         if IY = MAXY
  909.         then
  910.           begin
  911.             TY := TY - 1;
  912.             YY := MAP_SIZE;
  913.           end;
  914.  
  915.         loop
  916.           TX := (IX div SIDE) + 1;
  917.           XX := (IX mod SIDE) + 1;
  918.  
  919.           if IX = MAXX
  920.           then
  921.             begin
  922.               TX := TX - 1;
  923.               XX := MAP_SIZE;
  924.             end;
  925.  
  926.           if SHADOW_ON
  927.           then
  928.             PLOT_SRECT( MAP, IX, IY, TX, TY, XX, YY,
  929.                         XPNT, YPNT, MAXX, MAXY,
  930.                         SHADOW_REGION
  931.                       )
  932.           else
  933.             begin
  934.               HEIGHT := MAP[TX,TY]^[XX,YY];
  935.  
  936.               if WATER_ON
  937.               then
  938.                 if (HEIGHT <= WATER_LINE)
  939.                 then
  940.                   HEIGHT := WATER_LINE;
  941.  
  942.               if ( (IX = MAXX) or
  943.                    (IY = MAXY)
  944.                  )
  945.               then
  946.                 begin
  947.                   COLOR := 0;
  948.                   paint_color( 6 );
  949.                 end
  950.               else
  951.                 begin
  952.                   COLOR := ALT_TO_COL( HEIGHT );
  953.                   paint_color( LIGHT[ COLOR ] );
  954.                 end;
  955.  
  956.               HEIGHT := trunc((1.0*HEIGHT*PMAP_SIZE2)/RMAXALTITUDE);
  957.  
  958.               paint_rect( XPNT+IX,
  959.                           YPNT-HEIGHT,
  960.                           PIXEL_SIZE,
  961.                           HEIGHT
  962.                         );
  963.             end;
  964.  
  965.           DONE := QUICK_EXIT;   { check for the mouse button }
  966.  
  967.         exit if (IX >= MAXX) or DONE;
  968.           IX := IX + 1;
  969.         end;
  970.  
  971.         YPNT := YPNT + 1;
  972.         if (YPNT mod 2) = 0
  973.         then
  974.           XPNT := XPNT - PIXEL_SIZE;
  975.  
  976.       exit if (IY >= MAXY) or DONE;
  977.         IY := IY + 1;
  978.       end;
  979.  
  980.  
  981.       work_rect( GRAPHICS_WINDOW, X, Y, W, H );
  982.       SAVE_AREA( X, Y, W, H );
  983.       show_mouse; end_update;
  984.     end;
  985.  
  986. {*****************************************************************************}
  987.  
  988.   procedure PLOT_SHADOWED( var MAP : MAPTYPE;
  989.                                IX, IY, TX, TY, XX, YY : integer;
  990.                            var SHADOW_REGION : SHADOWREGION
  991.                          );
  992.     var
  993.       COLOR,
  994.       SHADOW_HEIGHT,
  995.       SHADOW_LENGTH : integer;
  996.       HEIGHT : real;
  997.     begin
  998.       with SHADOW_REGION do
  999.         begin
  1000.           if SHADOW_ON
  1001.           then
  1002.             begin
  1003.               HEIGHT := MAP[TX,TY]^[XX,YY];
  1004.               if WATER_ON
  1005.               then
  1006.                 if HEIGHT < WATER_LINE
  1007.                 then
  1008.                   HEIGHT := WATER_LINE;
  1009.  
  1010.               COLOR := ALT_TO_COL( round(HEIGHT) );
  1011.               SHADOW_LENGTH := round( (HEIGHT * MAP_SIZE)
  1012.                                       / (RMAXALTITUDE * TANGENT)
  1013.                                     );
  1014.               if (IX + SHADOW_LENGTH) <= (OX + SLENGTH)
  1015.               then
  1016.                 paint_color( SHADOW[ COLOR ] )
  1017.               else
  1018.                 begin
  1019.                   paint_color( LIGHT[ COLOR ] );
  1020.                   SLENGTH := SHADOW_LENGTH;
  1021.                   OHEIGHT := round(HEIGHT);
  1022.                   OX := IX;  OY := IY;
  1023.                 end;
  1024.             end
  1025.           else
  1026.             paint_color( LIGHT[ALT_TO_COL( round(HEIGHT) )] );
  1027.  
  1028.           paint_rect( WSX+PIXEL_SIZE*IX,
  1029.                       WSY+PIXEL_SIZE*IY,
  1030.                       PIXEL_SIZE, PIXEL_SIZE
  1031.                     );
  1032.         end;
  1033.     end;
  1034.  
  1035.  
  1036.   procedure REDRAW_MAP;
  1037.     var
  1038.       DONE,
  1039.       SAVE_WATCH : boolean;
  1040.       X, Y, W, H,
  1041.       IX, IY, TX, TY, XX, YY : integer;
  1042.       LOCATION : POINT;
  1043.       SHADOW_REGION : SHADOWREGION;
  1044.     begin
  1045.       SAVE_WATCH := WATCH_ON; WATCH_ON := true;
  1046.       bring_to_front( GRAPHICS_WINDOW );
  1047.       line_style( 1 );
  1048.       draw_mode( 1 );
  1049.       paint_style( 1 );
  1050.       work_rect( GRAPHICS_WINDOW, X, Y, W, H );
  1051.       set_clip( X, Y, W, H );
  1052.       set_window( GRAPHICS_WINDOW );
  1053.       begin_update; hide_mouse;
  1054.       if not BRAND_NEW
  1055.       then
  1056.         begin
  1057.           paint_color( 0 );
  1058.           paint_rect( 0, 0, W, H );
  1059.           DRAW_SCALE;
  1060.           paint_color( 1 );
  1061.           paint_rect( WSX-2, WSY-2,
  1062.                       (NUMXTILES*PMAP_SIZE)+4-(NUMXTILES-1),
  1063.                       (NUMYTILES*PMAP_SIZE)+4-(NUMYTILES-1)
  1064.                     );
  1065.           paint_color( 0 );
  1066.           paint_rect( WSX, WSY,
  1067.                       (NUMXTILES*PMAP_SIZE)-(NUMXTILES-1),
  1068.                       (NUMYTILES*PMAP_SIZE)-(NUMYTILES-1)
  1069.                     );
  1070.           paint_color( 0 );
  1071.         end;
  1072.  
  1073.       if SHADOW_ON
  1074.       then
  1075.         TANGENT := GET_TANGENT;
  1076.  
  1077.       IY := 0;
  1078.       loop
  1079.         TY := (IY div SIDE) + 1;
  1080.         YY := (IY mod SIDE) + 1;
  1081.         if IY = MAXY
  1082.         then
  1083.           begin
  1084.             TY := TY - 1;
  1085.             YY := MAP_SIZE;
  1086.           end;
  1087.  
  1088.         IX := 0;
  1089.         ENLIGHTEN( SHADOW_REGION );
  1090.         loop
  1091.           TX := (IX div SIDE) + 1;
  1092.           XX := (IX mod SIDE) + 1;
  1093.  
  1094.           if IX = MAXX
  1095.           then
  1096.             begin
  1097.               TX := TX - 1;
  1098.               XX := MAP_SIZE;
  1099.             end;
  1100.  
  1101.           if SHADOW_ON
  1102.           then
  1103.             PLOT_SHADOWED( MAP, IX, IY, TX, TY, XX, YY, SHADOW_REGION )
  1104.           else
  1105.             begin
  1106.               WX := WSX + ((TX-1) * SIDE);
  1107.               WY := WSY + ((TY-1) * SIDE);
  1108.               LOCATION.X := XX;       LOCATION.Y := YY;
  1109.               PLOT_LOCATION( MAP[TX,TY], LOCATION );
  1110.             end;
  1111.  
  1112.           DONE := QUICK_EXIT;      { check for the mouse button }
  1113.  
  1114.         exit if (IX >= MAXX) or DONE;
  1115.           IX := IX + 1;
  1116.         end;
  1117.  
  1118.       exit if (IY >= MAXY) or DONE;
  1119.         IY := IY + 1
  1120.       end;
  1121.  
  1122.       work_rect( GRAPHICS_WINDOW, X, Y, W, H );
  1123.       SAVE_AREA( X, Y, W, H );
  1124.       WATCH_ON := SAVE_WATCH;
  1125.       show_mouse; end_update;
  1126.     end;
  1127.  
  1128. {*****************************************************************************}
  1129.  
  1130.   procedure GET_SCALE_HEIGHT( var SCALE_HEIGHT : integer );
  1131.     begin
  1132.       SCALE_HEIGHT := do_alert('[0][| Height?    |][L|M|H]',3);
  1133.       case SCALE_HEIGHT of
  1134.         1 : SCALE_HEIGHT := PMAP_SIZE2;
  1135.         2 : SCALE_HEIGHT := MAP_SIZE div 2;
  1136.         3 : SCALE_HEIGHT := MAP_SIZE;
  1137.       end;
  1138.     end;
  1139.  
  1140.  
  1141.   procedure PERSPECTIVE( var MAP : MAPTYPE );
  1142.     var
  1143.       IX, IY,
  1144.       VHEIGHT, VPERCENT,
  1145.       LASTX,
  1146.       THISX,
  1147.       ALTITUDE,
  1148.       SCALE_HEIGHT,
  1149.       COLOR,
  1150.       OBJECT_HEIGHT,
  1151.       SHADOW_LENGTH,
  1152.       SHADOW_HEIGHT,
  1153.       TX, TY, XX, YY,
  1154.       X, Y, W, H : integer;
  1155.       XORIGIN, YORIGIN, WORIGIN,
  1156.       TPERCENT,
  1157.       HEIGHT : real;
  1158.       DONE,
  1159.       FIRST : boolean;
  1160.       SHADOW_REGION : SHADOWREGION;
  1161.     begin
  1162.       bring_to_front( GRAPHICS_WINDOW );
  1163.       GET_SCALE_HEIGHT( SCALE_HEIGHT );
  1164.       TANGENT := GET_TANGENT;
  1165.       work_rect( GRAPHICS_WINDOW, X, Y, W, H );
  1166.       set_clip( X, Y, W, H );
  1167.       set_window( GRAPHICS_WINDOW );
  1168.       begin_update; hide_mouse;
  1169.       paint_color( 1 );
  1170.       paint_rect( 0, 0, W, H );
  1171.       line_style( 1 );
  1172.       draw_mode( 1 );
  1173.       VHEIGHT := H;
  1174.       VPERCENT := 50;
  1175.       IY := 0;
  1176.       loop
  1177.         TPERCENT := (100.0 - VPERCENT) * (MAXY - IY) / MAXY;
  1178.         XORIGIN  := ((W/2.0) * TPERCENT / 100.0 ) + 1;
  1179.         YORIGIN  := (H+1.0) - (TPERCENT * VHEIGHT / 100.0);
  1180.         WORIGIN  := (100.0 - TPERCENT) * W / 100.0;
  1181.  
  1182.         TY := (IY div SIDE) + 1;
  1183.         YY := (IY mod SIDE) + 1;
  1184.         if IY = MAXY
  1185.         then
  1186.           begin
  1187.             TY := TY - 1;
  1188.             YY := MAP_SIZE;
  1189.           end;
  1190.  
  1191.         ENLIGHTEN( SHADOW_REGION );
  1192.         FIRST := true;
  1193.         IX := 0;
  1194.         loop
  1195.           TX := (IX div SIDE) + 1;
  1196.           XX := (IX mod SIDE) + 1;
  1197.  
  1198.           if IX = MAXX
  1199.           then
  1200.             begin
  1201.               TX := TX - 1;
  1202.               XX := MAP_SIZE;
  1203.             end;
  1204.  
  1205.           ALTITUDE := MAP[TX,TY]^[XX,YY];
  1206.           if WATER_ON and (ALTITUDE < WATER_LINE)
  1207.           then
  1208.             HEIGHT := WATER_LINE
  1209.           else
  1210.             HEIGHT := ALTITUDE;
  1211.  
  1212.           THISX := round( XORIGIN + (WORIGIN * IX / MAXX) );
  1213.           if FIRST
  1214.           then
  1215.             begin
  1216.               FIRST := not FIRST;
  1217.               LASTX := round(XORIGIN);
  1218.             end;
  1219.  
  1220.           if SHADOW_ON
  1221.           then
  1222.             with SHADOW_REGION do
  1223.               begin
  1224.                 COLOR := ALT_TO_COL( ALTITUDE );
  1225.  
  1226.                 { scale altitude to some convenient value, say, SCALE_HEIGHT }
  1227.                 SHADOW_LENGTH := round( HEIGHT * SCALE_HEIGHT
  1228.                                         / (RMAXALTITUDE * TANGENT)
  1229.                                       );
  1230.  
  1231.                 OBJECT_HEIGHT := round( HEIGHT * SCALE_HEIGHT / RMAXALTITUDE );
  1232.  
  1233.                 if (IX + SHADOW_LENGTH) <= (OX + SLENGTH)
  1234.                 then
  1235.                   begin
  1236.                     if ( (IX = MAXX) or
  1237.                          (IY = MAXY)
  1238.                        )
  1239.                     then
  1240.                       paint_color( 6 )
  1241.                     else
  1242.                       paint_color( SHADOW[ COLOR ] );
  1243.  
  1244.                     { scale for distance if enabled }
  1245.                     if SCALE_ON
  1246.                     then
  1247.                       OBJECT_HEIGHT := round(OBJECT_HEIGHT * (100.0 - TPERCENT)
  1248.                                              / 100.0
  1249.                                             );
  1250.  
  1251.                     paint_rect( LASTX,            round(YORIGIN-OBJECT_HEIGHT),
  1252.                                 (THISX-LASTX),    OBJECT_HEIGHT
  1253.                               );
  1254.                   end
  1255.                 else
  1256.                   begin
  1257.                     if SLENGTH <= 0
  1258.                     then
  1259.                       SHADOW_HEIGHT := 0
  1260.                     else
  1261.                       SHADOW_HEIGHT :=
  1262.                                 round( (0.0+SLENGTH-(IX-OX))*OHEIGHT/SLENGTH );
  1263.  
  1264.                     if ( (IX = MAXX) or
  1265.                          (IY = MAXY)
  1266.                        )
  1267.                     then
  1268.                       paint_color( 6 )
  1269.                     else
  1270.                       paint_color( LIGHT[ COLOR ] );
  1271.  
  1272.                     SLENGTH := SHADOW_LENGTH;
  1273.                     OHEIGHT := OBJECT_HEIGHT;
  1274.                     if SCALE_ON
  1275.                     then
  1276.                       begin
  1277.                       OBJECT_HEIGHT := round(OBJECT_HEIGHT * (100.0 - TPERCENT)
  1278.                                              / 100.0
  1279.                                             );
  1280.                       SHADOW_HEIGHT := round(SHADOW_HEIGHT * (100.0 - TPERCENT)
  1281.                                              / 100.0
  1282.                                             );
  1283.                       end;
  1284.  
  1285.                     paint_rect( LASTX,         round(YORIGIN-OBJECT_HEIGHT),
  1286.                                 (THISX-LASTX), OBJECT_HEIGHT
  1287.                               );
  1288.  
  1289.                     if ( (IX = MAXX) or
  1290.                          (IY = MAXY)
  1291.                        )
  1292.                     then
  1293.                       paint_color( 6 )
  1294.                     else
  1295.                       paint_color( SHADOW[ COLOR ] );
  1296.                     paint_rect( LASTX,         round(YORIGIN-SHADOW_HEIGHT),
  1297.                                 (THISX-LASTX), SHADOW_HEIGHT
  1298.                               );
  1299.  
  1300.                     OX := IX;  OY := IY;
  1301.                   end;
  1302.               end
  1303.           else
  1304.             begin
  1305.               { scale altitude to some convenient value, say, SCALE_HEIGHT }
  1306.               HEIGHT := HEIGHT * SCALE_HEIGHT / RMAXALTITUDE ;
  1307.  
  1308.               { scale for distance if enabled }
  1309.               if SCALE_ON
  1310.               then
  1311.                 HEIGHT := HEIGHT * (100.0 - TPERCENT) / 100.0;
  1312.  
  1313.               if (IY = MAXY)
  1314.               then
  1315.                 begin
  1316.                   paint_color( 6 );
  1317.                 end
  1318.               else
  1319.                 begin
  1320.                   COLOR := ALT_TO_COL( ALTITUDE );
  1321.                   paint_color( LIGHT[ COLOR ] );
  1322.                 end;
  1323.  
  1324.               paint_rect( LASTX,         round(YORIGIN-HEIGHT),
  1325.                           (THISX-LASTX), round(HEIGHT)
  1326.                         );
  1327.             end;
  1328.  
  1329.           LASTX := THISX;
  1330.           DONE := QUICK_EXIT;  { check for mouse button pressed }
  1331.  
  1332.         exit if (IX >= MAXX) or DONE;
  1333.           IX := IX + 1;
  1334.         end;
  1335.  
  1336.       exit if (IY >= MAXY) or DONE;
  1337.         IY := IY + 1
  1338.       end;
  1339.  
  1340.       work_rect( GRAPHICS_WINDOW, X, Y, W, H );
  1341.       SAVE_AREA( X, Y, W, H );
  1342.       show_mouse; end_update;
  1343.     end;
  1344.  
  1345. {*****************************************************************************}
  1346.  
  1347.   procedure SAVE_MAP( var MAP : MAPTYPE );
  1348.     var
  1349.       I,
  1350.       XX, YY, TX, TY, IX, IY : integer;
  1351.       PATHNAME  : path_name;
  1352.       FPTR      : file of integer; { LONGITUDE; }
  1353.     begin
  1354.       if get_out_file( 'Write to ...', PATHNAME )
  1355.       then
  1356.         begin
  1357.           rewrite( FPTR, PATHNAME );
  1358.           set_mouse( m_bee );
  1359.           if true
  1360.           then
  1361.             begin
  1362.               FPTR^ := NUMXTILES; put( FPTR );
  1363.               FPTR^ := NUMYTILES; put( FPTR );
  1364.  
  1365.               for I := 0 to 15 do
  1366.                 begin
  1367.                   FPTR^ := GET_XCOLOR( I );
  1368.                   put( FPTR );
  1369.                 end;
  1370.  
  1371.               for IY := 0 to MAXY do
  1372.                 begin
  1373.                   TY := (IY div SIDE) + 1;
  1374.                   YY := (IY mod SIDE) + 1;
  1375.                   if IY = MAXY
  1376.                   then
  1377.                     begin
  1378.                       TY := TY - 1;
  1379.                       YY := MAP_SIZE;
  1380.                     end;
  1381.  
  1382.                   for IX := 0 to MAXX do
  1383.                     begin
  1384.                       TX := (IX div SIDE) + 1;
  1385.                       XX := (IX mod SIDE) + 1;
  1386.  
  1387.                       if IX = MAXX
  1388.                       then
  1389.                         begin
  1390.                           TX := TX - 1;
  1391.                           XX := MAP_SIZE;
  1392.                         end;
  1393.  
  1394.                       FPTR^ := MAP[TX,TY]^[XX,YY];
  1395.                       put( FPTR );
  1396.                     end;
  1397.                 end;
  1398.  
  1399.               close( FPTR );
  1400.               INFO_LINE := concat( PATHNAME, '         ' );
  1401.               set_winfo( GRAPHICS_WINDOW,
  1402.                          INFO_LINE
  1403.                        );
  1404.             end
  1405.           else
  1406.             I := do_alert('[2][  I can''t write  |  to that file.  ][oh]',1);
  1407.  
  1408.           set_mouse( m_arrow );
  1409.         end;
  1410.     end;
  1411.  
  1412.  
  1413.   procedure LOAD_MAP( var MAP : MAPTYPE );
  1414.     var
  1415.       I,
  1416.       IX, IY, TX, TY, XX, YY : integer;
  1417.       FPTR : file of integer;
  1418.     begin
  1419.       if get_in_file( DEF_PATH, FILENAME )
  1420.       then
  1421.         begin
  1422.           reset( FPTR, FILENAME );
  1423.           set_mouse( m_bee );
  1424.           NUMXTILES := FPTR^;
  1425.           MAXX := NUMXTILES * SIDE;
  1426.           get( FPTR );
  1427.           NUMYTILES := FPTR^;
  1428.           MAXY := NUMYTILES * SIDE;
  1429.           for I := 0 to 15 do
  1430.             begin
  1431.               get( FPTR );
  1432.               SET_XCOLOR( I, FPTR^ );
  1433.             end;
  1434.  
  1435.           for IY := 0 to MAXY do
  1436.             begin
  1437.               TY := (IY div SIDE) + 1;
  1438.               YY := (IY mod SIDE) + 1;
  1439.               if IY = MAXY
  1440.               then
  1441.                 begin
  1442.                   TY := TY - 1;
  1443.                   YY := MAP_SIZE;
  1444.                 end;
  1445.  
  1446.               for IX := 0 to MAXX do
  1447.                 begin
  1448.                   TX := (IX div SIDE) + 1;
  1449.                   XX := (IX mod SIDE) + 1;
  1450.                   if IX = MAXX
  1451.                   then
  1452.                     begin
  1453.                       TX := TX - 1;
  1454.                       XX := MAP_SIZE;
  1455.                     end;
  1456.  
  1457.                   get( FPTR );
  1458.                   MAP[TX,TY]^[XX,YY] := FPTR^;
  1459.  
  1460.                   if XX = 1
  1461.                   then
  1462.                     if TX <> 1
  1463.                     then
  1464.                       MAP[TX-1,TY]^[MAP_SIZE,YY] := FPTR^;
  1465.  
  1466.                   if YY = 1
  1467.                   then
  1468.                     if TY <> 1
  1469.                     then
  1470.                       MAP[TX,TY-1]^[XX,MAP_SIZE] := FPTR^;
  1471.  
  1472.                 end;
  1473.             end;
  1474.  
  1475.           close( FPTR );
  1476.  
  1477.           INFO_LINE := concat( FILENAME, '         ' );
  1478.           set_winfo( GRAPHICS_WINDOW,
  1479.                      INFO_LINE
  1480.                    );
  1481.           set_mouse( m_arrow );
  1482.         end;
  1483.     end;
  1484.  
  1485.  
  1486.   procedure OLD_LOAD_MAP( var MAP : MAPTYPE );
  1487.     var
  1488.       I,
  1489.       TILEX, TILEY,
  1490.       X, Y : integer;
  1491.       FPTR : file of LONGITUDE;
  1492.     begin
  1493.       if get_in_file( DEF_PATH, FILENAME )
  1494.       then
  1495.         begin
  1496.           reset( FPTR, FILENAME );
  1497.           set_mouse( m_bee );
  1498.           NUMXTILES := FPTR^[ 1 ];
  1499.           MAXX := NUMXTILES * SIDE;
  1500.           NUMYTILES := FPTR^[ 2 ];
  1501.           MAXY := NUMYTILES * SIDE;
  1502.           for I := 0 to 15 do SET_XCOLOR( I, FPTR^[ I + 3 ] );
  1503.           for TILEX := 1 to NUMXTILES do
  1504.             for TILEY := 1 to NUMYTILES do
  1505.               for X := 1 to MAP_SIZE do
  1506.                 begin
  1507.                   get( FPTR );
  1508.                   MAP[TILEX,TILEY]^[X] := FPTR^;
  1509.                 end;
  1510.           close( FPTR );
  1511.           INFO_LINE := concat( FILENAME, '  (old format)' );
  1512.           set_winfo( GRAPHICS_WINDOW,
  1513.                      INFO_LINE
  1514.                    );
  1515.           set_mouse( m_arrow );
  1516.         end;
  1517.     end;
  1518.  
  1519. {*****************************************************************************}
  1520.  
  1521.   procedure DO_VIEW_MENU( ITEM : integer );
  1522.     var
  1523.       CHOICE : integer;
  1524.     begin
  1525.       if ITEM = TOP_ITEM
  1526.       then
  1527.         begin
  1528.           REDRAW_MAP( MAP );
  1529.         end
  1530.       else
  1531.         if ITEM = SIDE_ITEM
  1532.         then
  1533.           SIDE_MAP( MAP )
  1534.         else
  1535.           if ITEM = PERSPEC_ITEM
  1536.           then
  1537.             begin
  1538.               CHOICE := do_alert('[0][|  Scale?    |][Yes|No]',1);
  1539.               SCALE_ON := CHOICE = 1;
  1540.               PERSPECTIVE( MAP );
  1541.             end;
  1542.     end;
  1543.  
  1544.  
  1545.   procedure DO_FILE_MENU( ITEM : integer );
  1546.     begin
  1547.       if ITEM = QUIT_ITEM
  1548.       then
  1549.         begin
  1550.           close_window( GRAPHICS_WINDOW );
  1551.           delete_window( GRAPHICS_WINDOW );
  1552.         end
  1553.       else
  1554.         if ITEM = NEW_ITEM
  1555.         then
  1556.           begin
  1557.             if do_alert('[2][| Are you sure?  |][YES|NO]',2) = 1
  1558.             then
  1559.               begin
  1560.                 INFO_LINE := ' Unnamed map. ';
  1561.                 set_winfo( GRAPHICS_WINDOW,
  1562.                            INFO_LINE
  1563.                          );
  1564.                 DRAW_MAP( MAP );
  1565.                 menu_enable( MENU, SIDE_ITEM );
  1566.                 menu_enable( MENU, TOP_ITEM  );
  1567.                 menu_enable( MENU, PERSPEC_ITEM );
  1568.               end
  1569.           end
  1570.         else
  1571.           if ITEM = OLD_ITEM
  1572.           then
  1573.             begin
  1574.               OLD_LOAD_MAP( MAP );
  1575.               menu_enable( MENU, SIDE_ITEM );
  1576.               menu_enable( MENU, TOP_ITEM  );
  1577.               menu_enable( MENU, PERSPEC_ITEM );
  1578.             end
  1579.           else
  1580.             if ITEM = SAVE_ITEM
  1581.             then
  1582.               SAVE_MAP( MAP )
  1583.             else
  1584.               if ITEM = LOAD_ITEM
  1585.               then
  1586.                 begin
  1587.                   LOAD_MAP( MAP );
  1588.                   menu_enable( MENU, SIDE_ITEM );
  1589.                   menu_enable( MENU, TOP_ITEM  );
  1590.                   menu_enable( MENU, PERSPEC_ITEM );
  1591.                 end;
  1592.     end;
  1593.  
  1594.  
  1595.   procedure DO_OPTIONS_MENU( ITEM : integer );
  1596.     begin
  1597.       if ITEM = WATER_ITEM
  1598.       then
  1599.         begin
  1600.           WATER_ON := not WATER_ON;
  1601.           menu_check( MENU, WATER_ITEM, WATER_ON );
  1602.         end
  1603.       else
  1604.         if ITEM = WATCH_ITEM
  1605.         then
  1606.           begin
  1607.             WATCH_ON := not WATCH_ON;
  1608.             menu_check( MENU, WATCH_ITEM, WATCH_ON );
  1609.           end
  1610.         else
  1611.           if ITEM = SHADOW_ITEM
  1612.           then
  1613.             begin
  1614.               SHADOW_ON := not SHADOW_ON;
  1615.               menu_check( MENU, SHADOW_ITEM, SHADOW_ON );
  1616.             end
  1617.           else
  1618.             if ITEM = WIDTH_ITEM
  1619.             then
  1620.               begin
  1621.                 NUMXTILES := do_alert('[0][| Width?    |][1|2|3]',NUMXTILES);
  1622.                 MAXX := NUMXTILES * SIDE;
  1623.               end
  1624.             else
  1625.               if ITEM = HEIGHT_ITEM
  1626.               then
  1627.                 begin
  1628.                   NUMYTILES := do_alert('[0][| Height?   |][1|2]',NUMYTILES);
  1629.                   MAXY := NUMYTILES * SIDE;
  1630.                 end
  1631.               else
  1632.                 if ITEM = RESET_ITEM
  1633.                 then
  1634.                   SPECIAL_COLORS;
  1635.     end;
  1636.  
  1637.  
  1638.   procedure do_redraw( WINDOW, X0, Y0, W0, H0 : integer );
  1639.     var
  1640.       X, Y, W, H : integer;
  1641.     begin
  1642.       set_window(0);
  1643.       begin_update;
  1644.       hide_mouse;
  1645.       first_rect( WINDOW, X, Y, W, H );
  1646.       while (W <> 0) or (H <> 0) do
  1647.         begin
  1648.           if rect_intersect( X0, Y0, W0, H0, X, Y, W, H )
  1649.           then
  1650.             begin
  1651.               RESTORE_AREA( X, Y, W, H );
  1652.             end;
  1653.           next_rect( WINDOW, X, Y, W, H );
  1654.         end;
  1655.       show_mouse;
  1656.       end_update;
  1657.     end;
  1658.  
  1659.  
  1660.   procedure DO_ABOUT;
  1661.     var
  1662.       X, Y, H, W,
  1663.       BUTTON_PRESSED : integer;
  1664.     begin
  1665.       BUTTON_PRESSED := do_dialog( ABOUT_DIALOG, 0 );
  1666.       end_dialog( ABOUT_DIALOG );
  1667.       BUTTON_PRESSED := do_dialog( OSS_DIALOG, 0 );
  1668.       end_dialog( OSS_DIALOG );
  1669.     end;
  1670.  
  1671.  
  1672.   procedure do_menu( TITLE, ITEM : integer );
  1673.     begin
  1674.       if TITLE = VIEW_TITLE
  1675.       then
  1676.         DO_VIEW_MENU( ITEM )
  1677.       else
  1678.         if TITLE = FILE_TITLE
  1679.         then
  1680.           DO_FILE_MENU( ITEM )
  1681.         else
  1682.           if TITLE = OPTIONS_TITLE
  1683.           then
  1684.             DO_OPTIONS_MENU( ITEM )
  1685.           else
  1686.             if TITLE = DESK_TITLE
  1687.             then
  1688.               DO_ABOUT;
  1689.  
  1690.       menu_normal( MENU, TITLE );
  1691.     end;
  1692.  
  1693.  
  1694.  procedure CREATE_MENU;
  1695.     begin
  1696.       MENU := new_menu( 6, '  About TOPMAP  ' );
  1697.       FILE_TITLE    := add_mtitle( MENU, ' File ' );
  1698.       VIEW_TITLE    := add_mtitle( MENU, ' View ' );
  1699.       OPTIONS_TITLE := add_mtitle( MENU, ' Options ' );
  1700.       SHADOW_ITEM   := add_mitem( MENU, OPTIONS_TITLE, '  SHADOW ' );
  1701.       WATCH_ITEM    := add_mitem( MENU, OPTIONS_TITLE, '  WATCH  ' );
  1702.       WATER_ITEM    := add_mitem( MENU, OPTIONS_TITLE, '  WATER  ' );
  1703.       NULL2_ITEM    := add_mitem( MENU, OPTIONS_TITLE, '~~~~~~~~~' );
  1704.       HEIGHT_ITEM   := add_mitem( MENU, OPTIONS_TITLE, '  HEIGHT ' );
  1705.       WIDTH_ITEM    := add_mitem( MENU, OPTIONS_TITLE, '  WIDTH  ' );
  1706.       RESET_ITEM    := add_mitem( MENU, OPTIONS_TITLE, '  RESET  ' );
  1707.       SIDE_ITEM     := add_mitem( MENU, VIEW_TITLE, '  ISOMETETRIC   ' );
  1708.       TOP_ITEM      := add_mitem( MENU, VIEW_TITLE, '  OVERHEAD      ' );
  1709.       PERSPEC_ITEM  := add_mitem( MENU, VIEW_TITLE, '  PERSPECTIVE   ' );
  1710.       LOAD_ITEM     := add_mitem( MENU, FILE_TITLE, '  LOAD... ' );
  1711.       NEW_ITEM      := add_mitem( MENU, FILE_TITLE, '  NEW     ' );
  1712.       OLD_ITEM      := add_mitem( MENU, FILE_TITLE, '  OLD...  ' );
  1713.       SAVE_ITEM     := add_mitem( MENU, FILE_TITLE, '  SAVE... ' );
  1714.       NULL_ITEM     := add_mitem( MENU, FILE_TITLE, '==========' );
  1715.       QUIT_ITEM     := add_mitem( MENU, FILE_TITLE, '  QUIT    ' );
  1716.       menu_disable( MENU, NULL_ITEM    );
  1717.       menu_disable( MENU, NULL2_ITEM   );
  1718.       menu_disable( MENU, SIDE_ITEM    );
  1719.       menu_disable( MENU, TOP_ITEM     );
  1720.       menu_disable( MENU, PERSPEC_ITEM );
  1721.       WATER_ON  := true;  menu_check( MENU, WATER_ITEM,  WATER_ON  );
  1722.       WATCH_ON  := true;  menu_check( MENU, WATCH_ITEM,  WATCH_ON  );
  1723.       SHADOW_ON := true; menu_check( MENU, SHADOW_ITEM, SHADOW_ON );
  1724.     end;
  1725.  
  1726.  
  1727.   procedure CREATE_DIALOGS;
  1728.     var
  1729.       DUMMY : integer;
  1730.       BUFFER : STR255;
  1731.     begin
  1732.       ABOUT_DIALOG := new_dialog(10, 0,0,30,10 );
  1733.       DUMMY  := add_ditem( ABOUT_DIALOG,
  1734.                            g_text, none,
  1735.                            1,1,28,1,
  1736.                            0, $0180
  1737.                          );
  1738.       set_dtext( ABOUT_DIALOG, DUMMY,
  1739.                  'Fractal Topographical Maps', system_font, te_center
  1740.                );
  1741.  
  1742.       DUMMY := add_ditem( ABOUT_DIALOG,
  1743.                           g_text, none,
  1744.                           1,2,28,1,
  1745.                           0, $0180
  1746.                         );
  1747.       BUFFER := 'Copyright   1987';
  1748.       BUFFER[ 11 ] := chr(189);
  1749.       set_dtext( ABOUT_DIALOG, DUMMY,
  1750.                  BUFFER, system_font, te_center
  1751.                );
  1752.  
  1753.       DUMMY := add_ditem( ABOUT_DIALOG,
  1754.                           g_text, none,
  1755.                           1,3,28,1,
  1756.                           0, $0180
  1757.                         );
  1758.       set_dtext( ABOUT_DIALOG, DUMMY,
  1759.                  'by Robert Adam II.', system_font, te_center
  1760.                );
  1761.  
  1762.       DUMMY := add_ditem( ABOUT_DIALOG,
  1763.                           g_text, none,
  1764.                           1,4,28,1,
  1765.                           0, $0180
  1766.                         );
  1767.       set_dtext( ABOUT_DIALOG, DUMMY,
  1768.                  'All rights reserved.', system_font, te_center
  1769.                );
  1770.  
  1771.       DUMMY := add_ditem( ABOUT_DIALOG,
  1772.                           g_text, none,
  1773.                           1,5,28,1,
  1774.                           0, $0180
  1775.                         );
  1776.       set_dtext( ABOUT_DIALOG, DUMMY,
  1777.                  'You may give it away,', system_font, te_center
  1778.                );
  1779.  
  1780.       DUMMY := add_ditem( ABOUT_DIALOG,
  1781.                           g_text, none,
  1782.                           1,6,28,1,
  1783.                           0, $0180
  1784.                         );
  1785.       set_dtext( ABOUT_DIALOG, DUMMY,
  1786.                  'but not sell it.', system_font, te_center
  1787.                );
  1788.  
  1789.       DUMMY        := add_ditem( ABOUT_DIALOG,
  1790.                                  g_button, touch_exit | default,
  1791.                                  14,8,2,1,
  1792.                                  0, $0180
  1793.                                );
  1794.       set_dtext( ABOUT_DIALOG, DUMMY,
  1795.                  'ok', system_font, te_center
  1796.                );
  1797.       center_dialog( ABOUT_DIALOG );
  1798.  
  1799.  
  1800.       OSS_DIALOG := new_dialog(10, 0,0,30,10 );
  1801.  
  1802.       DUMMY := add_ditem( OSS_DIALOG,
  1803.                           g_text, none,
  1804.                           1,1,28,1,
  1805.                           0, $0180
  1806.                         );
  1807.       set_dtext( OSS_DIALOG, DUMMY,
  1808.                  'Portions of this product are',
  1809.                  system_font, te_center
  1810.                );
  1811.       DUMMY := add_ditem( OSS_DIALOG,
  1812.                           g_text, none,
  1813.                           1,2,28,1,
  1814.                           0, $0180
  1815.                         );
  1816.       BUFFER := 'Copyright   1986';
  1817.       BUFFER[ 11 ] := chr(189);
  1818.       set_dtext( OSS_DIALOG, DUMMY,
  1819.                  BUFFER,
  1820.                  system_font, te_center
  1821.                );
  1822.       DUMMY := add_ditem( OSS_DIALOG,
  1823.                           g_text, none,
  1824.                           1,3,28,1,
  1825.                           0, $0180
  1826.                         );
  1827.       set_dtext( OSS_DIALOG, DUMMY,
  1828.                  'OSS and CDD.',
  1829.                  system_font, te_center
  1830.                );
  1831.       DUMMY := add_ditem( OSS_DIALOG,
  1832.                           g_text, none,
  1833.                           1,4,28,1,
  1834.                           0, $0180
  1835.                         );
  1836.       set_dtext( OSS_DIALOG, DUMMY,
  1837.                  'Used by permission of OSS.',
  1838.                  system_font, te_center
  1839.                );
  1840.       DUMMY        := add_ditem( OSS_DIALOG,
  1841.                                  g_button, touch_exit | default,
  1842.                                  14,8,2,1,
  1843.                                  0, $0180
  1844.                                );
  1845.       set_dtext( OSS_DIALOG, DUMMY,
  1846.                  'ok', system_font, te_center
  1847.                );
  1848.       center_dialog( OSS_DIALOG );
  1849.     end;
  1850.  
  1851.  
  1852.   procedure CREATE_GWINDOW;
  1853.     begin
  1854.       MAIN_TITLE := COPYRIGHT1;
  1855.       GRAPHICS_WINDOW := new_window( g_name | g_info,
  1856.                                      MAIN_TITLE,
  1857.                                      0, 0, 0, 0
  1858.                                    );
  1859.       open_window( GRAPHICS_WINDOW,
  1860.                    0, 0, 0, 0
  1861.                  );
  1862.       INFO_LINE := ' No map.  ';
  1863.       set_winfo( GRAPHICS_WINDOW,
  1864.                  INFO_LINE
  1865.                );
  1866.  
  1867.       INIT_GWINDOW;
  1868.  
  1869.     end;
  1870.  
  1871.  
  1872.   procedure EVENT_LOOP;
  1873.  
  1874.     var
  1875.       WHICH : integer ;
  1876.       MSG   : message_buffer ;
  1877.  
  1878.     begin
  1879.       repeat
  1880.         WHICH := get_event( e_message, 0, 0, 0, 0,
  1881.                 false, 0, 0, 0, 0, false, 0, 0, 0, 0, msg,
  1882.                 dummy, dummy, dummy, dummy, dummy, dummy ) ;
  1883.         case msg[0] of
  1884.           mn_selected: DO_MENU( msg[3], msg[4] );
  1885.           wm_topped:
  1886.             bring_to_front( msg[3] ) ;
  1887.           wm_redraw:
  1888.              do_redraw( msg[3], msg[4], msg[5], msg[6], msg[7] ) ;
  1889.           wm_sized, wm_moved:
  1890.             set_wsize( msg[3], msg[4], msg[5], msg[6], msg[7] ) ;
  1891.           wm_closed:
  1892.             begin
  1893.               close_window( msg[3] ) ;
  1894.               delete_window( msg[3] ) ;
  1895.             end;
  1896.         end;
  1897.       until (msg[3] = FILE_TITLE) and (msg[4] = QUIT_ITEM)
  1898.     end;
  1899.  
  1900.  
  1901.   procedure ALLOCATE;
  1902.   { Allocate the space for the saved screen, the MFDBs and the map        }
  1903.     var
  1904.       TILEX, TILEY : integer;
  1905.     begin
  1906.       new( MEMORY );
  1907.       new( S_MFDB );
  1908.       new( D_MFDB );
  1909.       for TILEX := 1 to MAXXTILES do
  1910.         for TILEY := 1 to MAXYTILES do
  1911.           new( MAP[ TILEX, TILEY ] );
  1912.       READY_MFDB;
  1913.     end;
  1914.  
  1915. {}
  1916. { ... The main program ... }
  1917. {}
  1918.  
  1919.   begin
  1920.     if init_gem >= 0
  1921.     then
  1922.       begin
  1923.       { set up the global parameter variables }
  1924.         SAVE_COLORS;
  1925.         DEF_PATH := 'B:\*.MAP';
  1926.         WX := WSX;  WY := WSY;
  1927.         NUMXTILES := MAXXTILES;
  1928.         NUMYTILES := MAXYTILES;
  1929.         SIDE := MAP_SIZE - 1;
  1930.         MAXX := NUMXTILES * SIDE;
  1931.         MAXY := NUMYTILES * SIDE;
  1932.         BRAND_NEW := false;
  1933.         border_rect( 0, XSCRN, YSCRN, WSCRN, HSCRN );
  1934.         ALLOCATE;
  1935.  
  1936.       { create the dialogs and menu }
  1937.         set_mouse( m_bee );
  1938.         init_mouse;
  1939.         CREATE_MENU;
  1940.         CREATE_DIALOGS;
  1941.         hide_mouse;
  1942.  
  1943.       {   set the colors that are used to display the maps and initialize the }
  1944.       {  the global parameter variables that are associated with the colors   }
  1945.         SET_SPECIAL_COLORS;
  1946.  
  1947.       { create the window to be used to display the maps }
  1948.         CREATE_GWINDOW;
  1949.  
  1950.         set_mouse( m_bee );
  1951.         show_mouse;
  1952.  
  1953.       { display the menu.  This seems to take a few seconds to do. }
  1954.         draw_menu( MENU ) ;
  1955.  
  1956.         set_mouse( m_arrow );
  1957.  
  1958.       { wait for an event }
  1959.         EVENT_LOOP;
  1960.  
  1961.       { dispose of the menu }
  1962.         erase_menu( MENU ) ;
  1963.  
  1964.       { return the colors to the what they were before I changed them }
  1965.         RESTORE_COLORS;
  1966.         exit_gem;
  1967.       end;
  1968.   end.
  1969.